home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Languages Suite
/
ProgLangD.iso
/
Foxpro 2.6 {Windows}
/
APPMENU.PR_
/
APPMENU.bin
Wrap
Text File
|
1994-03-10
|
34KB
|
928 lines
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ 02/09/94 APPMENU.MPR 22:21:53 ║
* ║ ║
* ╟─────────────────────────────────────────────────────────╢
* ║ ║
* ║ Author's Name ║
* ║ ║
* ║ Copyright (c) 1994 Company Name ║
* ║ Address ║
* ║ City, Zip ║
* ║ ║
* ║ Description: ║
* ║ This program was automatically generated by GENMENU. ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ Setup Code ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
SET SYSMENU AUTOMATIC
EXTERNAL PROCEDURE showpop, juststem, justfname, justpath, addbs, ;
forceext, defaultext, justext
IF TYPE("SKIPVAR") <> "U"
RELEASE m.skipvar
ENDIF
PUBLIC m.skipvar
m.skipvar = .F.
CLEAR MACRO
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ Menu Definition ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
SET SYSMENU TO
SET SYSMENU AUTOMATIC
DEFINE PAD _qne1bxoga OF _MSYSMENU PROMPT "\<File" COLOR SCHEME 3
DEFINE PAD _qne1bxogl OF _MSYSMENU PROMPT "\<Edit" COLOR SCHEME 3 ;
KEY ALT+E, ""
DEFINE PAD _qne1bxogm OF _MSYSMENU PROMPT "\<Application" COLOR SCHEME 3 ;
KEY ALT+A, ""
DEFINE PAD _qne1bxoha OF _MSYSMENU PROMPT "\<Utilities" COLOR SCHEME 3 ;
KEY ALT+U, ""
DEFINE PAD _qne1bxohj OF _MSYSMENU PROMPT "\<Help" COLOR SCHEME 3 ;
KEY ALT+S, ""
ON PAD _qne1bxoga OF _MSYSMENU ACTIVATE POPUP file
ON PAD _qne1bxogl OF _MSYSMENU ACTIVATE POPUP edit
ON PAD _qne1bxogm OF _MSYSMENU ACTIVATE POPUP applicatio
ON PAD _qne1bxoha OF _MSYSMENU ACTIVATE POPUP utilities
ON PAD _qne1bxohj OF _MSYSMENU ACTIVATE POPUP help
DEFINE POPUP file MARGIN RELATIVE SHADOW COLOR SCHEME 13
DEFINE BAR _MFI_SETUP OF file PROMPT "\<Print Setup"
DEFINE BAR 2 OF file PROMPT "\-"
DEFINE BAR 3 OF file PROMPT "\<Quit"
ON SELECTION BAR 3 OF file ;
DO _qne1bxok2 ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
DEFINE POPUP edit MARGIN RELATIVE SHADOW COLOR SCHEME 4
DEFINE BAR _MED_CUT OF edit PROMPT "Cu\<t" ;
KEY CTRL+X, "Ctrl+X"
DEFINE BAR _MED_COPY OF edit PROMPT "\<Copy" ;
KEY CTRL+C, "Ctrl+C"
DEFINE BAR _MED_PASTE OF edit PROMPT "\<Paste" ;
KEY CTRL+V, "Ctrl+V"
DEFINE BAR _MED_PSTLK OF edit PROMPT "Paste \<Special..."
DEFINE BAR _MED_CLEAR OF edit PROMPT "Clear"
DEFINE BAR _MED_SP200 OF edit PROMPT "\-"
DEFINE BAR _MED_INSOB OF edit PROMPT "\<Insert Object..."
DEFINE BAR _MED_OBJ OF edit PROMPT "\<Object..."
DEFINE BAR _MED_LINK OF edit PROMPT "Change Lin\<k"
DEFINE BAR _MED_CVTST OF edit PROMPT "Con\<vert To Static"
DEFINE BAR _med_sp300 OF edit PROMPT "\-"
DEFINE BAR _MED_SLCTA OF edit PROMPT "Select \<All" ;
KEY CTRL+A, "Ctrl+A"
DEFINE BAR _MED_SP300 OF edit PROMPT "\-"
DEFINE BAR _MED_PREF OF edit PROMPT "\<Preferences..."
DEFINE POPUP applicatio MARGIN RELATIVE SHADOW COLOR SCHEME 4
DEFINE BAR 1 OF applicatio PROMPT "\<Top" ;
KEY F2, "F2" ;
SKIP FOR skipvar or bof()
DEFINE BAR 2 OF applicatio PROMPT "\<Previous" ;
KEY F5, "F5" ;
SKIP FOR skipvar or bof()
DEFINE BAR 3 OF applicatio PROMPT "\<Next" ;
KEY F4, "F4" ;
SKIP FOR skipvar or eof()
DEFINE BAR 4 OF applicatio PROMPT "\<End" ;
KEY F3, "F3" ;
SKIP FOR skipvar or eof()
DEFINE BAR _MWI_ROTAT OF applicatio PROMPT "C\<ycle" ;
KEY CTRL+F1, "Ctrl+F1"
DEFINE BAR 6 OF applicatio PROMPT "\-"
DEFINE BAR 7 OF applicatio PROMPT "\<Add Record" ;
KEY CTRL+N, "Ctrl+N" ;
SKIP FOR skipvar
DEFINE BAR 8 OF applicatio PROMPT "\<Copy Record" ;
SKIP FOR skipvar OR m.wiz_screen
DEFINE BAR 9 OF applicatio PROMPT "\<Delete Record" ;
KEY CTRL+D, "Ctrl+D" ;
SKIP FOR skipvar
DEFINE BAR 10 OF applicatio PROMPT "\-"
DEFINE BAR 11 OF applicatio PROMPT "Locate" ;
SKIP FOR skipvar
DEFINE BAR 12 OF applicatio PROMPT "\<Search..." ;
KEY CTRL+S, "Ctrl+S" ;
SKIP FOR skipvar
DEFINE BAR 13 OF applicatio PROMPT "\<Filter..." ;
KEY CTRL+F, "Ctrl+F" ;
SKIP FOR skipvar
DEFINE BAR 14 OF applicatio PROMPT "\<Order..." ;
KEY CTRL+O, "Ctrl+O" ;
SKIP FOR skipvar OR m.wiz_screen
DEFINE BAR 15 OF applicatio PROMPT "\-"
DEFINE BAR 16 OF applicatio PROMPT "Pick \<List" ;
KEY CTRL+L, "Ctrl+L" ;
SKIP FOR m.skipvar or m.nextdbf <= 2
DEFINE BAR 17 OF applicatio PROMPT "\-"
DEFINE BAR 18 OF applicatio PROMPT "\<Query..." ;
KEY CTRL+Q, "Ctrl+Q" ;
SKIP FOR skipvar or ('EXE' $ VERSION())
DEFINE BAR 19 OF applicatio PROMPT "\<Report..." ;
KEY CTRL+R, "Ctrl+R" ;
SKIP FOR skipvar
ON SELECTION BAR 1 OF applicatio ;
DO _qne1bxosk ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
ON SELECTION BAR 2 OF applicatio ;
DO _qne1bxotj ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
ON SELECTION BAR 3 OF applicatio ;
DO _qne1bxoud ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
ON SELECTION BAR 4 OF applicatio ;
DO _qne1bxova ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
ON SELECTION BAR 7 OF applicatio ;
DO _qne1bxowj ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
ON SELECTION BAR 8 OF applicatio ;
DO _qne1bxox9 ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
ON SELECTION BAR 9 OF applicatio ;
DO _qne1bxoyc ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
ON SELECTION BAR 11 OF applicatio ;
DO _qne1bxoyd ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
ON SELECTION BAR 12 OF applicatio ;
DO _qne1bxp05 ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
ON SELECTION BAR 13 OF applicatio ;
DO _qne1bxp06 ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
ON SELECTION BAR 14 OF applicatio ;
DO _qne1bxp1s ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
ON SELECTION BAR 16 OF applicatio DO showpop WITH ALIAS(),VARREAD()
ON SELECTION BAR 18 OF applicatio ;
DO _qne1bxp34 ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
ON SELECTION BAR 19 OF applicatio ;
DO _qne1bxp40 ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
DEFINE POPUP utilities MARGIN RELATIVE SHADOW COLOR SCHEME 4
DEFINE BAR 1 OF utilities PROMPT "\<Refresh Screen" ;
SKIP FOR skipvar
DEFINE BAR 2 OF utilities PROMPT "\<Construct Index" ;
SKIP FOR skipvar
DEFINE BAR 3 OF utilities PROMPT "\<Pack" ;
SKIP FOR skipvar
ON SELECTION BAR 1 OF utilities ;
DO _qne1bxp5u ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
ON SELECTION BAR 2 OF utilities ;
DO _qne1bxp5v ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
ON SELECTION BAR 3 OF utilities ;
DO _qne1bxp7h ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
DEFINE POPUP help MARGIN RELATIVE SHADOW COLOR SCHEME 4
DEFINE BAR _MST_HELP OF help PROMPT "\<Help..." ;
KEY F1, "F1"
DEFINE BAR 2 OF help PROMPT "\-"
DEFINE BAR _MST_MACRO OF help PROMPT "\<Macros"
DEFINE BAR _MST_CALCU OF help PROMPT "\<Calculator"
DEFINE BAR _MST_DIARY OF help PROMPT "Calendar/\<Diary"
DEFINE BAR _MST_PUZZL OF help PROMPT "Pu\<zzle"
DEFINE BAR 7 OF help PROMPT "\-"
DEFINE BAR 8 OF help PROMPT "\<About..."
ON SELECTION BAR 8 OF help ;
DO _qne1bxpae ;
IN LOCFILE("\WIZARDS\APPMENU" ,"MPX;MPR|FXP;PRG" ,"Where is APPMENU?")
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXOK2 ON SELECTION BAR 3 OF POPUP file ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 8 ║
* ║ Called By: ON SELECTION BAR 3 OF POPUP file ║
* ║ Prompt: Quit ║
* ║ Snippet: 1 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxok2
* Select the main database
dbfstem = makealias(juststem(m.dbfname))
SELECT (dbfstem)
=actwin(woutput())
bailout = .T.
CLEAR READ
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXOSK ON SELECTION BAR 1 OF POPUP applicatio ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 27 ║
* ║ Called By: ON SELECTION BAR 1 OF POPUP applicatio ║
* ║ Prompt: Top ║
* ║ Snippet: 2 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxosk
GOTO TOP
IF !m.wiz_screen
ACTIVATE WINDOW appctrl
ENDIF
IF m.wiz_screen
SCATTER MEMVAR MEMO
ENDIF
WAIT WINDOW "Top of file" NOWAIT
SHOW GETS
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXOTJ ON SELECTION BAR 2 OF POPUP applicatio ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 28 ║
* ║ Called By: ON SELECTION BAR 2 OF POPUP applicatio ║
* ║ Prompt: Previous ║
* ║ Snippet: 3 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxotj
SKIP -1
IF BOF()
WAIT WINDOW "Top of file" NOWAIT
GOTO TOP
ENDIF
IF m.wiz_screen
SCATTER MEMVAR MEMO
ENDIF
SHOW GETS
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXOUD ON SELECTION BAR 3 OF POPUP applicatio ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 29 ║
* ║ Called By: ON SELECTION BAR 3 OF POPUP applicatio ║
* ║ Prompt: Next ║
* ║ Snippet: 4 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxoud
SKIP
IF EOF()
WAIT WINDOW "End of file" NOWAIT
GOTO BOTTOM
ENDIF
IF m.wiz_screen
SCATTER MEMVAR MEMO
ENDIF
SHOW GETS
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXOVA ON SELECTION BAR 4 OF POPUP applicatio ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 30 ║
* ║ Called By: ON SELECTION BAR 4 OF POPUP applicatio ║
* ║ Prompt: End ║
* ║ Snippet: 5 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxova
GOTO BOTTOM
IF m.wiz_screen
SCATTER MEMVAR MEMO
ENDIF
WAIT WINDOW "End of file" NOWAIT
SHOW GETS
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXOWJ ON SELECTION BAR 7 OF POPUP applicatio ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 33 ║
* ║ Called By: ON SELECTION BAR 7 OF POPUP applicatio ║
* ║ Prompt: Add Record ║
* ║ Snippet: 6 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxowj
#DEFINE C_NOPARENT "You cannot add a child record if there is no parent."
IF m.wiz_screen
do ("btn_val") WITH "ADD"
ELSE
* Add a record to the current database. Called from "Add Record" menu option, if
* this is not a wizard screen.
*-------------------------------------------------------------------------------
EXTERNAL ARRAY dbflist
PRIVATE allblank, i, fldname, sname, c_rec
IF (m.nextdbf <= 2) OR (ALIAS() = dbflist[1,m.cstemnum])
* Appending into main database
* Always allow this if there are no records; otherwise check for existing
* blank records.
allblank = .F.
IF RECCOUNT() > 0
sname = makealias(juststem(m.dbfname))
SELECT (sname)
GOTO TOP
DO WHILE DELETED() AND !EOF()
SKIP
ENDDO
IF EOF() && all records appear to be deleted
GOTO TOP
ENDIF
=actwin(m.win_name)
m.allblank = .T.
FOR i = 1 TO FCOUNT()
m.fldname = FIELD(i)
IF !EMPTY(&fldname)
m.allblank = .F.
ENDIF
ENDFOR
* Make sure all records aren't deleted
IF m.allblank
IF RECCOUNT() < 10 && just a rule of thumb
COUNT FOR !DELETED() TO notdel
GOTO TOP
IF m.notdel = 0
m.allblank = .F.
ENDIF
ENDIF
ENDIF
ENDIF
IF !m.allblank
APPEND BLANK
SHOW GETS
ENDIF
_CUROBJ = 1
IF m.wiz_screen
SCATTER MEMVAR MEMO
SHOW GETS
ENDIF
=actwin(m.win_name)
ELSE && appending record into a child browse
* Fill in the key fields. First find the dbflist record for this
* database.
i = 1
got_it = .F.
DO WHILE i <= m.numareas AND !got_it
IF UPPER(dbflist[i,m.cstemnum]) == ALIAS()
got_it = .T.
ELSE
i = i + 1
ENDIF
ENDDO
* If we found the current database, figure out what the parent database
* is and make sure that the parent is not at EOF().
IF !EOF(dbflist[m.i,m.pdbfnum])
* Also determine what its key field is and make it default
* to the corresponding value in the parent database. For
* example, if the current database is an invoice file, make the
* customer number default to the customer number of the current
* record in the customer file.
APPEND BLANK
IF got_it
* dbflist[m.i,m.cfldnum] looks like "DETAIL.INO"
childfld = dbflist[m.i,m.cfldnum]
parentfld = dbflist[m.i,m.pfldnum]
* Replace the key field into the newly appended record
REPLACE &childfld WITH &parentfld
ENDIF
ELSE
WAIT WINDOW C_NOPARENT
ENDIF
SHOW WINDOW (ALIAS()) REFRESH
ENDIF
ENDIF
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXOX9 ON SELECTION BAR 8 OF POPUP applicatio ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 34 ║
* ║ Called By: ON SELECTION BAR 8 OF POPUP applicatio ║
* ║ Prompt: Copy Record ║
* ║ Snippet: 7 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxox9
SCATTER MEMVAR
APPEND BLANK
GATHER MEMVAR
IF TYPE("DBFLIST") = "U" OR ALIAS() == UPPER(dbflist[1,m.cstemnum])
SHOW GETS
=actwin(m.win_name) && activate user window
ENDIF
SHOW WINDOW (ALIAS()) REFRESH
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXOYC ON SELECTION BAR 9 OF POPUP applicatio ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 35 ║
* ║ Called By: ON SELECTION BAR 9 OF POPUP applicatio ║
* ║ Prompt: Delete Record ║
* ║ Snippet: 8 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxoyc
* Delete this record (and any children for which the cascading
* delete option is set) from the current database.
PRIVATE m.delrec, m.wasdeleted
m.wasdeleted = .F.
IF RECCOUNT() > 0
IF m.wiz_screen
m.delrec = recno()
DO ("btn_val") WITH "DELETE"
m.wasdeleted = RECNO() <> m.delrec && Wizard code deletes record and moves record
&& pointer. Use this to detect deletion (user
&& could have Canceled). In FoxApp, we want to
&& call procedure Cascade before the deletion,
&& so recall and delete again afterward.
GO m.delrec
RECALL
ELSE
WAIT WINDOW "Deleting--Please wait." NOWAIT
m.wasdeleted = .t.
ENDIF
IF m.wasdeleted
* Perform any necessary cascading deletes
IF m.nextdbf > 1
DO Cascade WITH ALIAS(), "DELETE"
ENDIF
DELETE
* Moving off the deleted record if we are in the main screen
IF TYPE("DBFLIST") = "U" OR ALIAS() = dbflist[1,m.cstemnum]
IF !EOF()
SKIP
ENDIF
IF EOF()
GOTO TOP
ENDIF
IF m.wiz_screen
SCATTER MEMVAR MEMO
ENDIF
SHOW GETS
ELSE
SHOW WINDOW (ALIAS()) REFRESH
ENDIF
WAIT CLEAR
ENDIF
ENDIF
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXOYD ON SELECTION BAR 11 OF POPUP applicatio ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 37 ║
* ║ Called By: ON SELECTION BAR 11 OF POPUP applicatio ║
* ║ Prompt: Locate ║
* ║ Snippet: 9 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxoyd
m.skipvar = .T.
dbfstem = makealias(juststem(m.dbfname))
SELECT (dbfstem)
IF m.wiz_screen
DO ("btn_val") WITH "LOCATE"
ELSE
DEFINE WINDOW FA_loc FROM 1,1 TO 20,40;
SYSTEM GROW CLOSE ZOOM FLOAT
MOVE WINDOW FA_loc CENTER
ON KEY LABEL enter KEYBOARD(CHR(23))
BROWSE WINDOW FA_loc NOEDIT NODELETE NOAPPEND ;
NOMENU TITLE "Locate Record" COLOR SCHEME 10
ON KEY LABEL enter
RELEASE WINDOW FA_loc
SHOW MENU _msysmenu
=actwin(woutput())
ENDIF
m.skipvar = .F.
IF m.wiz_screen
SCATTER MEMVAR MEMO
ENDIF
SHOW GETS
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXP05 ON SELECTION BAR 12 OF POPUP applicatio ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 38 ║
* ║ Called By: ON SELECTION BAR 12 OF POPUP applicatio ║
* ║ Prompt: Search... ║
* ║ Snippet: 10 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxp05
m.dbfstem = makealias(juststem(m.dbfname))
SELECT (m.dbfstem)
IF !m.regen
m.mname = 'appsrch.prg'
ELSE
m.mname = 'appsrch.spr'
ENDIF
DO (m.mname)
IF m.wiz_screen
SCATTER MEMVAR MEMO
ENDIF
SHOW GETS
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXP06 ON SELECTION BAR 13 OF POPUP applicatio ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 39 ║
* ║ Called By: ON SELECTION BAR 13 OF POPUP applicatio ║
* ║ Prompt: Filter... ║
* ║ Snippet: 11 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxp06
m.orig_rec = RECNO()
GETEXPR 'Filter Expression' TO m.filt_expr TYPE 'L' DEFAULT m.filt_expr
IF !EMPTY(m.filt_expr)
SET FILTER TO &filt_expr
GOTO TOP
IF EOF()
WAIT WINDOW "No records match that filter" NOWAIT
SET FILTER TO
IF m.orig_rec <= RECCOUNT()
GOTO m.orig_rec
ENDIF
ENDIF
ELSE
SET FILTER TO
ENDIF
IF m.wiz_screen
SCATTER MEMVAR MEMO
ENDIF
SHOW GETS
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXP1S ON SELECTION BAR 14 OF POPUP applicatio ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 40 ║
* ║ Called By: ON SELECTION BAR 14 OF POPUP applicatio ║
* ║ Prompt: Order... ║
* ║ Snippet: 12 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxp1s
m.dbfstem = makealias(juststem(m.dbfname))
SELECT (m.dbfstem)
IF !EMPTY(CDX(1))
IF !m.regen
m.mname = 'getorder.prg'
ELSE
m.mname = 'getorder.spr'
ENDIF
DO (m.mname)
IF m.wiz_screen
SCATTER MEMVAR MEMO
ENDIF
SHOW GETS
ELSE
WAIT WINDOW "No indexes were found"
ENDIF
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXP34 ON SELECTION BAR 18 OF POPUP applicatio ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 44 ║
* ║ Called By: ON SELECTION BAR 18 OF POPUP applicatio ║
* ║ Prompt: Query... ║
* ║ Snippet: 13 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxp34
PRIVATE gen_name, i, qname, pname, win_name
CREATE VIEW qprview
* Select the main database
m.dbfstem = makealias(juststem(m.dbfname))
SELECT (m.dbfstem)
m.skipvar = .T.
m.gen_name = .F.
* Default query name is the database name with a QPR extension.
m.qname = addbs(m.qprpath) + forceext(justfname(m.dbfname),'QPR')
* If there are multiple databases in this app, create a query template
* so that the user doesn't have to enter all the relations again.
IF m.nextdbf > 2 AND TYPE("dbflist") <> "U"
* Create a blank query file to pass the databases and relations
* along to RQBE
* Try to come up with a reasonable-sounding unique name for the query,
* if the default name is already taken.
m.i = 0
DO WHILE FILE(m.qname) AND i < 100
m.qname = ALLTRIM(LEFT(juststem(m.qname),6)) + STR(m.i,2)
m.qname = CHRTRAN(m.qname,' ','0')
m.qname = forceext(m.qname,'QPR')
m.qname = addbs(m.qprpath) + m.qname
m.i = m.i + 1
ENDDO
* Prompt the user for the query name and allow changes.
* Change to the directory the user wants to use so that the
* PUTFILE directory defaults are right.
m.in_dir = SET('DEFAULT')+CURDIR()
SET DEFAULT TO (qprpath)
m.qname = PUTFILE('Query name',m.qname,'QPR','OK')
SET DEFAULT TO (m.in_dir)
IF EMPTY(m.qname) && user changed his mind.
m.skipvar = .F.
RETURN
ELSE
* Use this path for future queries
m.qprpath = justpath(m.qname)
ENDIF
* Create the query template file
SET TEXTMERGE TO (m.qname)
SET TEXTMERGE ON
SET CONSOLE OFF
m.gen_name = .T. && note that this is a generated file
\SELECT * ;
\ FROM <<dbflist[1,m.cstemnum]>>
FOR m.i = 2 TO m.nextdbf - 1
\\, <<dbflist[m.i,m.cstemnum]>>
ENDFOR
\\ ;
\ WHERE ;
FOR m.i = 2 TO m.nextdbf - 1
IF m.i > 2
\ AND
ELSE
\
ENDIF
\\ <<dbflist[m.i,m.cfldnum]>> = <<dbflist[m.i,m.pfldnum]>> ;
ENDFOR
\INTO CURSOR FoxApp
\BROWSE NOMODIFY
SET CONSOLE ON
SET TEXTMERGE OFF
SET TEXTMERGE TO
ELSE
* Prompt the user for the query name
m.qname = PUTFILE('Query name',m.qname,'QPR','OK')
ENDIF
IF !EMPTY(m.qname)
m.win_name = WOUTPUT()
ACTIVATE SCREEN
IF FILE(m.qname)
MODIFY QUERY (m.qname)
ELSE
CREATE QUERY (m.qname)
ENDIF
CLEAR
IF !EMPTY(m.win_name)
ACTIVATE WINDOW (m.win_name)
ENDIF
ELSE
* Delete this file if it was a generated file and the
* user cancelled the query.
IF m.gen_name AND FILE(m.qname)
DELETE FILE m.qname
ENDIF
ENDIF
IF EMPTY(opendbf(m.dbfname))
m.dbfname = LOCFILE(m.dbfname,'DBF','Please locate the database')
ENDIF
m.skipvar = .F.
IF FILE('qprview.vue')
SET VIEW TO qprview
ENDIF
KEYBOARD CHR(27) && force screen refresh
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXP40 ON SELECTION BAR 19 OF POPUP applicatio ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 45 ║
* ║ Called By: ON SELECTION BAR 19 OF POPUP applicatio ║
* ║ Prompt: Report... ║
* ║ Snippet: 14 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxp40
IF !m.regen
m.mname = 'prtopts.prg'
ELSE
m.mname = 'prtopts.spr'
ENDIF
DO (m.mname)
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXP5U ON SELECTION BAR 1 OF POPUP utilities ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 48 ║
* ║ Called By: ON SELECTION BAR 1 OF POPUP utilities ║
* ║ Prompt: Refresh Screen ║
* ║ Snippet: 15 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxp5u
=actwin(m.win_name) && activate user window
KEYBOARD CHR(27)
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXP5V ON SELECTION BAR 2 OF POPUP utilities ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 49 ║
* ║ Called By: ON SELECTION BAR 2 OF POPUP utilities ║
* ║ Prompt: Construct Index ║
* ║ Snippet: 16 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxp5v
DO invert WITH ALIAS()
SET ORDER TO 1
GOTO TOP
_CUROBJ = 1
WAIT WINDOW "Reindexing completed" NOWAIT
SHOW GETS
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXP7H ON SELECTION BAR 3 OF POPUP utilities ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 50 ║
* ║ Called By: ON SELECTION BAR 3 OF POPUP utilities ║
* ║ Prompt: Pack ║
* ║ Snippet: 17 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxp7h
PACK && also reindexes the file
SET ORDER TO 1
GOTO TOP
IF RECCOUNT() = 0
APPEND BLANK
ENDIF
WAIT WINDOW "Pack completed" NOWAIT
KEYBOARD CHR(27) && causes screen refresh and restores browses
SHOW GETS
* ╓─────────────────────────────────────────────────────────╖
* ║ ║
* ║ _QNE1BXPAE ON SELECTION BAR 8 OF POPUP help ║
* ║ ║
* ║ Procedure Origin: ║
* ║ ║
* ║ From Menu: APPMENU.MPR, Record: 61 ║
* ║ Called By: ON SELECTION BAR 8 OF POPUP help ║
* ║ Prompt: About... ║
* ║ Snippet: 18 ║
* ║ ║
* ╙─────────────────────────────────────────────────────────╜
*
PROCEDURE _qne1bxpae
IF !regen
mname = 'appabout.prg'
ELSE
mname = 'appabout.spr'
ENDIF
DO (mname)